home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1998 January: Mac OS SDK / Dev.CD Jan 98 SDK1.toast / Development Kits (Disc 1) / Communications Toolbox / CTB Sample Code 1.0b16 / CTB Sources / Sources 2 / File Transfer Tool for CTB / ftutil.p < prev    next >
Encoding:
Text File  |  1989-10-06  |  12.3 KB  |  452 lines  |  [TEXT/MPS ]
  1. {************************************************************************************
  2. *
  3. *  Project Name:    FTTools
  4. *     File Name:    ftutil.p
  5. *       Authors:    Rob Neville, Alex Kazim, Carol Lee, Byron Han
  6. *          Date:    May 17, 1989
  7. *
  8. *   Description:    
  9. *
  10. *************************************************************************************
  11. *
  12. *    Revision History:
  13. *        5/17/89 - Original version by Rob Neville
  14. *        6/26/89 - Rev'd for b2 of Comm Toolbox
  15. *        7/24/89 - Rev'd for b4 of Comm Toolbox
  16. *
  17. ************************************************************************************}
  18.  
  19.  
  20. UNIT FTUtil;
  21.  
  22. INTERFACE
  23.  
  24. USES
  25. MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf, 
  26. FixMath, Script,ConnectionTool,CRMIntf;
  27.  
  28. CONST
  29.     Toke_Max        = 256;        { max # of tokens            }
  30.     String_Space    = 4096;        { space for strings            }
  31.     WhiteTokens     = [tokenWhite,tokenNewLine,tokenNoBreakSpace];
  32.     NumberTokens    = [tokenNumeric,tokenAltNum,tokenRealNum,tokenAltReal];
  33.     Res_ID_Limit    = 100;
  34.  
  35.     
  36.  
  37. function InitTokenBlock(var aTokenPtr:TokenBlockPtr): OSErr;
  38. procedure DisposeTokenBlock(aTokenPtr: TokenBlockPtr);
  39. function MatchResString(aString: str255;start,finish,StrResID:integer): integer;
  40. function GetSuperToken(aTokenPtr: TokenBlockPtr; var offset: integer; var theString: Str255): integer;
  41. function StrLen(theString:Ptr):longint;
  42. function TranslateConfig(procID: integer; inputStr: Ptr; var outputStr: Ptr; fromLanguage,toLanguage: longint;toolClass: ResType): longint;
  43. function MyCat(var toPtr:Ptr;theString:Str255;calStrSize:Boolean): longint;
  44.  
  45. IMPLEMENTATION
  46.  
  47.  
  48. {    ********************************    }
  49. {    Returns the length of a c-string    }
  50. {    ********************************    }
  51.  
  52. function strLen(theString:Ptr):longint;
  53. var
  54.     endPtr    : Ptr;
  55.     
  56. begin
  57.     endPtr:= theString;
  58.     while endPtr^ <> 0 do        {scan until we find \0 termination}
  59.         endPtr:= ptr(ord(endPtr) + 1);
  60.     strLen:= ord4(endPtr) - ord4(theString);
  61. end;
  62.  
  63.  
  64.  
  65. {    ********************************************    }
  66. {    initialize the token block for tokenize call    }
  67. {    ********************************************    }
  68.  
  69. function InitTokenBlock(var aTokenPtr:TokenBlockPtr): OSErr;
  70. CONST    
  71.     Toke_Max        = 256;                    { max # of tokens            }
  72.     String_Space    = 4096;                    { space for strings            }
  73. VAR
  74.     Itl4            : Itl4Handle;            { the itl4 resource            }
  75.  
  76. BEGIN
  77.     Itl4 := Itl4Handle(IUGetIntl(4));        { Get the 'itl4' resource    }
  78.     
  79.     if (Itl4 = nil) then begin                { Which way did he go?        }
  80.         InitTokenBlock := ResError;
  81.         EXIT(InitTokenBlock);
  82.     end;
  83.     
  84.     HLock(Handle(Itl4));                    { Give Blood                }
  85.     
  86.     { gimme space    }
  87.     aTokenPtr := TokenBlockPtr(NewPtr(sizeof(TokenBlock)));
  88.     if (aTokenPtr = nil) then begin
  89.         InitTokenBlock := MemError;
  90.         EXIT(InitTokenBlock);
  91.     end;
  92.     
  93.     { gimme more    }
  94.     aTokenPtr^.tokenList := NewPtr(sizeof(TokenRec) * Toke_Max);
  95.     if (aTokenPtr^.tokenList = nil) then begin
  96.         DisposPtr(Ptr(aTokenPtr));
  97.         InitTokenBlock := MemError;
  98.         EXIT(InitTokenBlock);
  99.     end;
  100.     
  101.     { # of tokens to allow                        }
  102.     aTokenPtr^.tokenLength := Toke_Max;
  103.     aTokenPtr^.tokenCount := 0;
  104.     
  105.     { build strings of each token                }
  106.     aTokenPtr^.stringList := NewPtr(String_Space);
  107.     if (aTokenPtr^.stringList = nil) then begin
  108.         DisposPtr(aTokenPtr^.tokenList);
  109.         DisposPtr(Ptr(aTokenPtr));
  110.         InitTokenBlock := MemError;
  111.         EXIT(InitTokenBlock);
  112.     end;
  113.     
  114.     aTokenPtr^.stringLength := String_Space;
  115.     aTokenPtr^.stringCount := 0;
  116.     
  117.     { set the controls to the heart of the sun    }
  118.     aTokenPtr^.doString := true;            
  119.     aTokenPtr^.doAppend := false;
  120.     aTokenPtr^.doAlphanumeric := true;
  121.     aTokenPtr^.doNest := false;
  122.     
  123.     { parser info for double quotes                }
  124.     aTokenPtr^.leftDelims[0] := token2Quote;
  125.     aTokenPtr^.leftDelims[1] := DelimPad;
  126.     
  127.     aTokenPtr^.rightDelims[0] := token2Quote;
  128.     aTokenPtr^.rightDelims[1] := DelimPad;
  129.     
  130.     { parser info for comments: unused            }
  131.     aTokenPtr^.leftComment[0] := DelimPad;
  132.     aTokenPtr^.leftComment[1] := DelimPad;
  133.     aTokenPtr^.leftComment[2] := DelimPad;
  134.     aTokenPtr^.leftComment[3] := DelimPad;
  135.     
  136.     aTokenPtr^.rightComment[0] := DelimPad;
  137.     aTokenPtr^.rightComment[1] := DelimPad;
  138.     aTokenPtr^.rightComment[2] := DelimPad;
  139.     aTokenPtr^.rightComment[3] := DelimPad;
  140.     
  141.     { "\"" will generate a token2Quote            }
  142.     aTokenPtr^.escapeCode := tokenBackSlash;
  143.     aTokenPtr^.decimalCode := tokenPeriod;
  144.     aTokenPtr^.itlResource := Handle(Itl4);
  145.     aTokenPtr^.reserved[0] := 0;
  146.     aTokenPtr^.reserved[1] := 0;
  147.     aTokenPtr^.reserved[2] := 0;
  148.     aTokenPtr^.reserved[3] := 0;
  149.     aTokenPtr^.reserved[4] := 0;
  150.     aTokenPtr^.reserved[5] := 0;
  151.     aTokenPtr^.reserved[6] := 0;
  152.     aTokenPtr^.reserved[7] := 0;
  153.     
  154.     HUnlock(Handle(Itl4));
  155.     
  156.     InitTokenBlock := noErr;
  157. END;
  158.  
  159. procedure DisposeTokenBlock(aTokenPtr: TokenBlockPtr);
  160. BEGIN
  161.     if (aTokenPtr <> nil) then begin
  162.         if (aTokenPtr^.stringList <> nil) then
  163.             DisposPtr(aTokenPtr^.stringList);
  164.         
  165.         if (aTokenPtr^.TokenList <> nil) then
  166.             DisposPtr(Ptr(aTokenPtr^.TokenList));
  167.         
  168.         DisposPtr(Ptr(aTokenPtr));        {clean it up, boys}
  169.     end;
  170. END;
  171.  
  172. FUNCTION GetSuperToken(aTokenPtr: TokenBlockPtr; var offset: INTEGER;
  173.                                         var theString: Str255): INTEGER;
  174. VAR
  175.     myToken        : TokenRecPtr;
  176.     
  177. BEGIN
  178.     theString := '';
  179.     
  180.     myToken := TokenRecPtr(ORD4(aTokenPtr^.tokenList) + 
  181.                                         offset * sizeof(TokenRec));
  182.     
  183.     { if it's a white token then return that    }
  184.     if (myToken^.theToken in WhiteTokens) then begin
  185.         offset := offset + 1;
  186.         theString := myToken^.stringPosition^;
  187.         GetSuperToken := tokenWhite;
  188.     end
  189.     else if myToken^.theToken = tokenLeftLit then begin
  190.     
  191.         { if tokenLeftLit, walk 'till tokenRightLit    }
  192.         { this way we get escape chars as well        }
  193.         
  194.         { get the next token    }
  195.         offset := offset + 1;
  196.         myToken := TokenRecPtr(ORD4(aTokenPtr^.tokenList) + 
  197.                                         offset * sizeof(TokenRec));
  198.         
  199.         { walk 'till right lit    }
  200.         while (myToken^.theToken <> tokenRightLit) and 
  201.                         (offset < aTokenPtr^.tokenCount) do begin
  202.             
  203.             { Do I need to interpret \n as newline, etc    ???}
  204.             
  205.             { eat the escape, but print the rest    }
  206.             if (myToken^.theToken <> tokenEscape) then
  207.                 theString := concat(theString,myToken^.stringPosition^);
  208.             
  209.             offset := offset + 1;
  210.             myToken := TokenRecPtr(ORD4(aTokenPtr^.tokenList) + 
  211.                                         offset * sizeof(TokenRec));
  212.         end; { while    }
  213.         
  214.         offset := offset + 1;        { get rid of right quote        }
  215.         
  216.         GetSuperToken := tokenAlpha;
  217.         
  218.     end
  219.     else begin        { start concating them until next white token    }
  220.     
  221.         GetSuperToken := myToken^.theToken;
  222.         
  223.         { walk 'till next white space    }
  224.         while not (myToken^.theToken in WhiteTokens) and 
  225.                         (offset < aTokenPtr^.tokenCount) do begin
  226.             theString := concat(theString,myToken^.stringPosition^);
  227.             
  228.             offset := offset + 1;
  229.             myToken := TokenRecPtr(ORD4(aTokenPtr^.tokenList) + 
  230.                                         offset * sizeof(TokenRec));
  231.         end; { while    }
  232.         
  233.     end; { else    }
  234. END;
  235.  
  236.  
  237.  
  238. {    ************************************************************    }
  239. {    Searches for a match between passed string and str# resource    }
  240. {    specified by StrResID and returns the index of the string in    }
  241. {    str# resource                                                    }
  242. {    ************************************************************    }
  243.  
  244. function MatchResString(aString: str255;start,finish,StrResID:integer): integer;
  245. const
  246.     string_not_found = -1;
  247. var
  248.     i        : integer;
  249.     resStr    : str255;
  250.     
  251. begin
  252.     for i := start to finish do
  253.     begin
  254.         GetIndString(resStr,StrResID,i);
  255.         if EqualString(resStr,aString,false,false) then
  256.         begin
  257.             MatchResString := i;
  258.             EXIT(MatchResString);
  259.         end;
  260.     end;
  261.     MatchResString := string_not_found;
  262. end; {MatchResString}
  263.  
  264.  
  265.  
  266. {    ****************************************************************    }
  267. {    Concatenates a Str255 onto the end of a zero-terminated c string    }
  268. {    Returns any memory allocation errors                                }
  269. {    ****************************************************************    }
  270.  
  271. function MyCat(var toPtr:Ptr;theString:Str255;calStrSize:Boolean): longint;
  272. VAR
  273.     stringlen    : longint;
  274.     
  275. BEGIN
  276.     stringlen := length(theString);
  277.     
  278.     if not calStrSize then begin
  279.         BlockMove(Ptr(ORD4(@theString)+1),toPtr,stringlen);
  280.         
  281.         toPtr := Ptr(ORD4(toPtr) + stringlen);
  282.         toPtr^ := ord(' ');
  283.         
  284.         toPtr := Ptr(ORD4(toPtr) + 1);    { advance the ptr and leave }
  285.     end;
  286.     
  287.     MyCat := stringlen + 1;                    { size + 1    }
  288. END; {MyCat}
  289.  
  290. FUNCTION TranslateConfig(procID: INTEGER; inputStr: Ptr; var outputStr: Ptr;
  291.                                         fromLanguage,toLanguage: LONGINT;
  292.                                                     toolClass: ResType): LONGINT;
  293. TYPE
  294.     IntPtr        = ^INTEGER;
  295.     
  296. VAR
  297.     returnVal        : INTEGER;        {any Errors encountered}
  298.     aTokenPtr        : TokenBlockPtr;
  299.     tokeStr            : Str255;
  300.     alienStr        : Str255;
  301.     savedoutputStr    : Ptr ;
  302.     localOutputStr    : Ptr ;
  303.     myToken            : TokenRecPtr;
  304.     i                : INTEGER;        {loop counter}    
  305.     totalLen        : LONGINT;
  306.     notDone            : Boolean ;
  307.     firstPass        : Boolean ;
  308.     stringlen        : INTEGER ;
  309.     resIndexList     : PACKED ARRAY[1..Toke_Max] OF INTEGER;
  310.     maxString        : INTEGER;
  311.     resH            : Handle;
  312.     oldResRef        : INTEGER;
  313.     offset            : INTEGER;
  314.     
  315. BEGIN
  316.     outputStr := nil ;                    { set outputStr to zero in case of error }
  317.     {Map resources to local IDs}
  318.     
  319.     if  (fromLanguage > Res_ID_Limit) or 
  320.                 (toLanguage > Res_ID_Limit) then begin
  321.         TranslateConfig := 0 ;
  322.         EXIT( TranslateConfig ) ;
  323.     end;
  324.     
  325.     fromLanguage:= CRMLocalToRealID(toolClass, procID,'STR#',fromLanguage);
  326.     toLanguage:=  CRMLocalToRealID(toolClass, procID,'STR#',toLanguage);
  327.     
  328.     oldResRef := CurResFile;            { Put us at the forefront    }
  329.     UseResFile(procID);
  330.     
  331.     resH := Get1Resource('STR#',fromLanguage);
  332.     if resH <> nil then
  333.         maxString := IntPtr(resH^)^
  334.     else
  335.         maxString := 0;
  336.         
  337.     UseResFile(oldResRef);
  338.  
  339.     notDone := TRUE  ;
  340.     firstPass := TRUE ;            
  341.     if (fromLanguage = -1) or (toLanguage = -1) then begin
  342.         { language not found in resource }
  343.         TranslateConfig := 0 ;
  344.         EXIT( TranslateConfig ) ;
  345.     end; 
  346.     
  347.     returnVal:= InitTokenBlock(aTokenPtr);
  348.     if returnVal <> noErr then begin
  349.         TranslateConfig:= returnVal;
  350.         EXIT(TranslateConfig);                             {abort, abort}
  351.     end;
  352.     
  353.     returnVal := 0 ;                                  { init returnVal for later use }
  354.     aTokenPtr^.source := inputStr;                    { what to parse            }
  355.     aTokenPtr^.sourceLength := StrLen(inputStr);    { just how long            }
  356.     
  357.     {tokenize the string}
  358.     if IntlTokenize(aTokenPtr) <> tokenOK then begin
  359.         DisposeTokenBlock(aTokenPtr);
  360.         TranslateConfig:= -1;                                { Unknown error     }
  361.         EXIT(TranslateConfig);                                { Warp Factor 8        }
  362.     end;
  363.     
  364.     oldResRef := CurResFile;
  365.     UseResFile(procID);
  366.  
  367.     { we have to visit the tokens twice because the length of the outstr }
  368.     { has to be figured out and memory space has to allocated before     }
  369.     { we actually copy anything to outstr                                }
  370.     while notDone do begin
  371.             
  372.         offset := 0;        { offset into the tokenBlock    }
  373.         
  374.         for i:= 1 to aTokenPtr^.tokenCount do begin
  375.             
  376.             myToken := TokenRecPtr(ORD4(aTokenPtr^.tokenList) + 
  377.                                         offset * sizeof(TokenRec));
  378.             tokeStr := '';
  379.             
  380.             { Translate only Alpha tokens    }
  381.             if (myToken^.theToken = tokenAlpha) then begin
  382.                         
  383.                 { walk 'till next white space    }
  384.                 while not (myToken^.theToken in WhiteTokens) and 
  385.                                 (offset < aTokenPtr^.tokenCount) do begin
  386.                     tokeStr := concat(tokeStr,myToken^.stringPosition^);
  387.                     
  388.                     offset := offset + 1;
  389.                     myToken := TokenRecPtr(ORD4(aTokenPtr^.tokenList) + 
  390.                                                 offset * sizeof(TokenRec));
  391.                 end; { while    }
  392.                 
  393.                 { find in the from language                    }
  394.                 if firstPass then
  395.                     resIndexList[i] := 
  396.                         MatchResString(tokeStr,1,maxString,fromLanguage);
  397.                 
  398.                 { get the equivalent from the to language    }
  399.                 if resIndexList[i] <> -1 then begin
  400.                     GetIndString(alienStr,toLanguage,resIndexList[i]);
  401.                     if length(alienStr) > 0 then
  402.                         tokeStr := alienStr;
  403.                 end;
  404.                 
  405.             end {tokenAlpha}
  406.             else begin            { just copy other token    }
  407.             
  408.                 offset := offset + 1;
  409.                 tokeStr := myToken^.stringPosition^;
  410.                 
  411.             end; {token type?    }
  412.                 
  413.             stringlen := length(tokeStr);
  414.             
  415.             if firstPass then                { we just want the length in the first pass }
  416.                 returnVal := returnVal + stringlen
  417.             else begin                        { copy to the output string                    }
  418.                 BlockMove(Ptr(ORD4(@tokeStr) + 1), localOutputStr, stringlen);
  419.                 localOutputStr := Ptr(ORD4(localOutputStr) + stringlen);
  420.             end;
  421.             
  422.             if (offset >= aTokenPtr^.tokenCount) then
  423.                 leave;
  424.         end; {for every token}
  425.         
  426.         if firstPass then begin
  427.             firstPass := FALSE ;
  428.             localOutputStr := NewPtr(returnVal+1) ;    { extra one for null terminator }
  429.             if localOutputStr = nil then begin
  430.                 TranslateConfig := MemError ;
  431.                 DisposeTokenBlock(aTokenPtr);
  432.                 EXIT(TranslateConfig);
  433.             end 
  434.             else
  435.                 { save a copy of the pointer, since we'll be advancing localOutputStr }
  436.                 savedoutputStr := localOutputStr ;
  437.         end
  438.         else
  439.             notDone := FALSE;                { I'm all done with it }
  440.     end; { while    }
  441.     
  442.     UseResFile(oldResRef);
  443.     
  444.     localOutPutStr^ := 0 ;                    { null terminate the returned C-string }
  445.     outputStr := savedoutputStr;
  446.  
  447.     DisposeTokenBlock(aTokenPtr);
  448.     TranslateConfig := 0 ;
  449. END; {TranslateConfig}
  450.  
  451.  
  452. END.